SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00003 1 05-25-9408:08ALL LEE KIRBY DOS pipe as input SWAG9405 15 .l πPROGRAM DFile;ππ{ Purpose: Given, DIR [filespec] /S /B, delete all occurrences of [filespec] }π{ from the current directory on. }π{ Example: dir *.bak /s /b | dfile }ππVARπ In_File : TEXT; { for standard input }π Key : CHAR; { for user confirmation }π Files_Deleted : INTEGER; { for number of files deleted }ππFUNCTION GetKey : CHAR;ππ{ The ASCII code is in AL, which is the place you need }π{ it to be as the byte return value of a function. }π{ Provided by Drew Veliath of 1:272/60@fidonet.org }ππINLINE ( $B4 / $00 / { MOV AH,0 }π $CD / $16 ); { INT $16 }ππPROCEDURE Delete_Files ( VAR In_File : TEXT;π VAR Files_Deleted : INTEGER );πVARπ Trgt_File : TEXT; { for file to be deleted }π File_Spec : STRING; { for filespec entered by user }ππBEGINπ WHILE NOT EOF ( In_File ) DO BEGINπ READLN ( In_File, File_Spec );π ASSIGN ( Trgt_File, File_Spec );π {$I-}π ERASE ( Trgt_File );π {$I+}π IF IORESULT = 0 THEN BEGINπ INC ( Files_Deleted );π WRITELN ( 'Deleted ', File_Spec )π END { IF IORESULT = 0 }π END { WHILE NOT EOF ( In_File ) }πEND; { PROCEDURE Delete_Files }ππBEGIN { main program }π WRITE ( 'Are you sure [yn]? ' );π Key := GetKey;π WRITELN;π Files_Deleted := 0;π IF UPCASE ( Key ) = 'Y' THEN BEGINπ ASSIGN ( In_File, '' ); { assign In_File to standard input }π RESET ( In_File );π Delete_Files ( In_File, Files_Deleted );π CLOSE ( In_File )π END; { IF UPCASE ( Key ) = 'Y' }π WRITELN;π WRITELN ( Files_Deleted, ' file(s) deleted.' )πEND. { main program }π 2 05-25-9408:19ALL RONEN MAGID File and Record Locks SWAG9405 31 .l {πThis is a demonstration of a network unit capable of lockingπpascal records or any set of bytes on a file.ππProgrammer: Ronen Magid, Qiyat-Ono Israel.πContributed to the SWAG.π}ππUnit Network;πInterfaceπUses Dos;ππVarπ Regs : Registers;π RegSize : Byte;π RecSize : Longint;π OffSet : LongInt;π FileHandle : word;ππConstπ SH_COMPAT = $0000;π SH_DENYRW = $0010;π SH_DENYWR = $0020;π SH_DENYRD = $0030;π SH_DENYNONE = $0040;π SH_DENYNO = SH_DENYNONE;π O_RDONLY = $0;π O_WRITE = $1;π O_RDWR = $2;ππfunction Lock(Var Handle: Word; Var Offset, BufLen: Longint): Word;πfunction Unlock(Var Handle: Word; Var OffSet, BufLen: Longint): Word;ππImplementationππfunction Lock(var handle: word; var offset, buflen: longint): word;πvarπ TempOffset:longint;πbeginπ Lock := 0;π TempOffset:=1000000000+Offset;π fillchar(regs, sizeof(regs), 0);π regs.ah := $5C; { Lock file access }π regs.al := 0;π regs.bx := handle;π regs.cx := TempOffset shr RegSize; {and $ffff;}π regs.dx := TempOffset and $ffff;π regs.si := buflen shr RegSize; {and $ffff;}π regs.di := buflen and $ffff;π MsDos(regs);π if (regs.Flags and 1) <> 0 thenπ Lock := regs.ax;πend;ππfunction Unlock(var handle: word; var offset, buflen: longint): word;πvarπ TempOffset:longint;πbeginπ Unlock := 0;π TempOffset:=1000000000+Offset;π regs.ah := $5C; { Unlock file access }π regs.al := 1;π regs.bx := handle;π regs.cx := TempOffset shr RegSize; {and $ffff;}π regs.dx := TempOffset and $ffff;π regs.si := buflen shr RegSize; {and $ffff;}π regs.di := buflen and $ffff;π MsDos(regs);π if (regs.Flags and 1) <> 0 thenπ Unlock := regs.ax;πend;ππEnd.ππ{ --------------------- TEST CODE ... CUT HERE -------------------}ππ{πThis demonstartion will show how to use the NETWORK file-lockπunit to allow lock and lock-check of records in a regularπpascal database file.ππProgrammer: Ronen Magid, Qiyat-Ono Israel.πContributed to the SWAG.π}ππProgram NetTest;πuses Dos,Network;ππTypeπ PhoneRecord = Recordπ Name : String[30];π Address : String[35];π Phone : String[15];π End;ππVarπ PhoneRec : PhoneRecord;π PhoneFile : File of PhoneRecord;π FileHandle : word;π LockStatus : Word;π I : Byte;π Ok : Boolean;ππFunction LockPhoneRec(which: LongInt): Boolean;πBeginπ recsize := SizeOf(PhoneRec);π OffSet := RecSize * Which - Recsize;π FileHandle := FileRec(PhoneFile).handle;π LockStatus := Lock(FileHandle, offset, recsize);π if LockStatus = 0 thenπ beginπ LockPhoneRec:=True;π end elseπ beginπ LockPhoneRec:=False;π end;πend;ππfunction UnLockPhoneRec(Which: Byte): boolean;πvarπ ok: boolean;πbeginπ recsize := SizeOf(PhoneRec);π OffSet := Which * RecSize - RecSize;π FileHandle := FileRec(PhoneFile).handle;π LockStatus := Unlock(FileHandle, offset, recsize);π if LockStatus <> 0 thenπ beginπ UnlockPhoneRec := false;π end elseπ beginπ UnlockPhoneRec := true;π end;πend;ππbeginπ Assign(Phonefile,'PHONE.SMP');π Rewrite(Phonefile);π For I:=1 to 5 do Write(Phonefile,phoneRec);π Close(Phonefile);ππ FileMode := SH_DENYNO + O_RDWR; {Important, Before RESET!}π Reset(Phonefile);ππ { And now lets begin to lock... }ππ Ok:=LockPhoneRec(2);π {Locking phone rec 2}ππ {Now lets see if its locked... }ππ Ok:=LockPhoneRec(2);π {a record is already locked if weπ cant lock it. This locking procedureπ can be performed by other PCs & otherπ tasks.}ππ If Not Ok then writeln('#2 locked');ππ Ok:=UnlockPhoneRec(2);π { lets release it. This will enableπ other tasks or LAN PCs to lockπ (& obtain) this record again...}ππ If Ok then Writeln('Rec #2 unlocked');ππ {thats it...}π Ok:=LockPhoneRec(2);π If Ok then Writeln('And since its free we can relock it !');π Close(phoneFile);πEnd.π 3 05-26-9406:11ALL MARTIN ISREALSEN Buffered Fileread SWAG9405 62 .l π(************************************************************************)π(* *)π(* Program ex. to : "Tips & Tricks in Turbo Pascal", SysTime 1993 *)π(* *)π(* By : Martin Israelsen *)π(* *)π(* Title : BUFFER.PAS *)π(* *)π(* Chapter : 5 *)π(* *)π(* Description : Quicker than Turbo fileread *)π(* *)π(************************************************************************)π(*$I-*) (* Iocheck off *)π(*$F+*) (* Force FAR call *)π(*$V-*) (* Relaxed VAR check *)π(*$R-*) (* Range check off *)π(*$S-*) (* Stack check off *)π(*$Q-*) (* Overflow off *)π(*$D-*) (* Debug off *)π(*$L-*) (* Linenumber off *)ππUnitπ Buffer;ππInterfaceππTypeππ PByte = ^Byte;π PWord = ^Word;π PLong = ^Longint;ππ PByteArr = ^TByteArr;π TByteArr = Array[1..64000] Of Byte;π PfStr = String[100];ππ PBuffer = ^TBuffer;π TBuffer = Recordπ BufFil : File;π BufPtr : PByteArr;ππ BufSize,π BufIndex,π BufUsed : Word;ππ BufFPos,π BufFSize : Longint;π End;ππFunction BufferInit(Var Br: PBuffer; MemSize: Word;π FilName: PfStr): Boolean;πProcedure BufferClose(Var Br: PBuffer);ππFunction BufferGetByte(Br: PBuffer): Byte;πFunction BufferGetByteAsm(Br: PBuffer): Byte;ππFunction BufferGetWord(Br: PBuffer): Word;πProcedure BufferGetBlock(Br: PBuffer; Var ToAdr; BlockSize: Word);πFunction BufferGetStringAsm(Br: PBuffer): String;ππFunction BufferEof(Br: PBuffer): Boolean;ππImplementationππ(*$I-,F+*)ππFunction BufferInit(Var Br: PBuffer; MemSize: Word;π FilName: PfStr): Boolean;πBeginπ BufferInit:=False;ππ (* Check if there's enough memory *)ππ If MemSize<500 Then Exit;π If MaxAvail<Sizeof(TBuffer)+MemSize+32 Then Exit;ππ New(Br);ππ With BR^ Doπ Beginπ BufSize:=MemSize; BufIndex:=1; BufFPos:=0;ππ (* Open the filen. Exit if there's an error *)ππ Assign(BufFil,Filname); Reset(BufFil,1);ππ If IoResult<>0 Thenπ Beginπ Dispose(Br);π Exit;π End;ππ (* Ok, the file is there, and there's enough *)π (* memory. So allocate the memory and read *)π (* as much as possible *)ππ GetMem(BufPtr,BufSize);π BlockRead(BufFil,BufPtr^,BufSize,BufUsed);ππ BufFSize:=FileSize(BufFil); Inc(BufFPos,BufUsed);π End;ππ BufferInit:=True;πEnd;ππProcedure BufferClose(Var Br: PBuffer);πBeginπ With Br^ Doπ Beginπ Close(BufFil);π Freemem(BufPtr,BufSize);π End;ππ Dispose(Br);πEnd;ππProcedure BufferCheck(Br: PBuffer; ReqBytes: Word);πVarπ W,Rest: Word;πBeginπ With Br^ Doπ Beginπ If (BufIndex+ReqBytes>BufUsed) And (BufUsed=BufSize) Thenπ Beginπ Rest:=Succ(BufSize-BufIndex);ππ Move(BufPtr^[BufIndex],BufPtr^[1],Rest);π BufIndex:=1;ππ BlockRead(BufFil,BufPtr^[Succ(Rest)],BufSize-Rest,W);π BufUsed:=Rest+W; Inc(BufFPos,W);π End;π End;πEnd;ππFunction BufferGetByte(Br: PBuffer): Byte;πBeginπ With Br^ Doπ Beginπ BufferCheck(Br,1);ππ BufferGetByte:=BufPtr^[BufIndex];π Inc(BufIndex);π End;πEnd;ππFunction BufferGetByteAsm(Br: PBuffer): Byte; Assembler;πAsmπ Les Di,Br (* ES:DI -> BRecPtr *)ππ Mov Ax,Es:[Di.TBuffer.BufIndex] (* Check wheather the buffer should be updated *)π Cmp Ax,Es:[Di.TBuffer.BufUsed]π Jle @@NoBufCheck (* If not jump on *)ππ Push Word Ptr Br[2] (* Push BR to BufferCheck *)π Push Word Ptr Brπ Mov Ax,0001 (* Check for one byte *)π Push Ax (* Push it *)π Push CS (* Push CS, and make a *)π Call Near Ptr BufferCheck (* NEAR call - it's quicker *)ππ Les Di,Br (* ES:DI-> BRecPtr *)ππ @@NoBufCheck:ππ Mov Bx,Es:[Di.TBuffer.BufIndex] (* BufferIndex in BX *)π Inc Es:[Di.TBuffer.BufIndex] (* Inc BufferIndex directly *)π Les Di,Es:[Di.TBuffer.BufPtr] (* ES:DI -> BufPtr *)ππ Xor Ax,Ax (* Now get the byte *)π Mov Al,Byte Ptr Es:[Di+Bx-1]πEnd;ππFunction BufferGetWord(Br: PBuffer): Word;πBeginπ With Br^ Doπ Beginπ BufferCheck(Br,2);ππ BufferGetWord:=PWord(@BufPtr^[BufIndex])^;π Inc(BufIndex,2);π End;πEnd;ππProcedure BufferGetBlock(Br: PBuffer; Var ToAdr; BlockSize: Word);πBeginπ With Br^ Doπ Beginπ BufferCheck(Br,BlockSize);ππ Move(BufPtr^[BufIndex],ToAdr,BlockSize);π Inc(BufIndex,BlockSize);π End;πEnd;ππFunction BufferGetStringAsm(Br: PBuffer): String; Assembler;πAsmπ Push Dsππ Les Di,Br (* es:di -> Br *)π Mov Bx,Es:[Di.TBuffer.BufUsed] (* check for buffercheck *)π Sub Bx,Es:[Di.TBuffer.BufIndex]π Cmp Bx,257π Jae @NoBufCheck (* Jump on if not *)ππ Push Word Ptr Br[2]π Push Word Ptr Brππ Mov Ax,257π Push Axππ Push Csπ Call Near Ptr BufferCheckππ Les Di,Brππ @NoBufCheck:ππ Mov Bx,Es:[Di.TBuffer.BufIndex] (* Get index in buffer *)π Dec Bx (* Adjust for 0 *)ππ Les Di,Es:[Di.TBuffer.BufPtr] (* Point to the buffer *)π Add Di,Bx (* Add Index *)π Push Di (* Save currect position *)ππ Mov Al,$0a (* Search for CR = 0ah *)π Mov Cx,$ff (* max. 255 chars *)ππ Cld (* Remember *)π RepNz Scasb (* and do the search *)π Jz @Fundet (* Jump if we found one *)ππ Mov Cx,0 (* Otherwise set length to 0 *)π @Fundet:π Sub Cx,$ff (* Which will be recalculated *)π Neg Cx (* to nomal length *)π Dec Cx (* Dec, to avoid CR *)ππ Push Es (* DS:SI->Buffer *)π Pop Dsπ Pop Siππ Les Di,@Result (* ES:DI->result string *)π Mov Ax,Cxππ Stosb (* Set length *)ππ Shr Cx,1 (* Copy the string *)π Rep MovSwπ Adc Cx,Cxπ Rep MovSbππ Pop Ds (* Restore DS *)ππ Les Di,Br (* ES:DI->Br *)π Inc Ax (* Inc Ax, point to LF *)ππ Add Es:[Di.TBuffer.BufIndex],Ax (* and set BufferIndex *)πEnd;πππFunction BufferEof(Br: PBuffer): Boolean;πBeginπ With Br^ Doπ BufferEof:=(BufIndex>BufUsed) And (BufFPos=BufFSize);πEnd;ππEnd.ππ
